home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programmierung
/
Power-Programmierung (Tewi)(1994).iso
/
euphoria
/
display.e
< prev
next >
Wrap
Text File
|
1994-02-10
|
12KB
|
459 lines
-- display.e
-- graphics, sound and text display on screen
global sequence ship
global sequence ds -- Euphoria deflectors
global sequence ts -- Euphoria torpedos
global sequence ps -- Euphoria anti-matter pods
global function c_remaining()
-- number of C ships (of all types) left
return nobj[G_KRC] + nobj[G_ANC] + nobj[G_CPP]
end function
type negative_atom(atom x)
return x <= 0
end type
global procedure p_energy(negative_atom delta)
-- print Euphoria energy
atom energy
energy = quadrant[EUPHORIA][Q_EN] + delta
quadrant[EUPHORIA][Q_EN] = energy
if energy < 0 then
energy = 0
gameover = TRUE
end if
position(WARP_LINE, ENERGY_POS+7)
set_bk_color(WHITE)
if energy < 5000 then
set_color(RED+BLINKING)
else
set_color(BLACK)
end if
printf(CRT, "%d ", floor(energy))
end procedure
global procedure task_life()
-- independent task: life support energy
if shuttle then
p_energy(-3)
else
p_energy(-17)
end if
end procedure
------------------------- message handler -----------------------------
-- All messages come here. An independent task ensures that messages
-- will be displayed on the screen for at least a second or so, before
-- being overwritten by the next message. If there is no queue, a
-- message will be printed immediately, otherwise it is added to the queue.
-- A message is deleted from the queue when its time on the screen
-- is up.
constant MESSAGE_GAP = 1.2 -- seconds between messages for readability
sequence message_queue
message_queue = {}
global procedure set_msg()
-- prepare to print a message
set_bk_color(WHITE)
set_color(RED)
position(MSG_LINE, MSG_POS)
puts(CRT, BLANK_LINE[1..50])
position(MSG_LINE, MSG_POS)
end procedure
global procedure msg(sequence text)
-- print a plain text message on the message line
if length(message_queue) = 0 then
-- print it right away
set_msg()
puts(CRT, text)
sched(TASK_MESSAGE, MESSAGE_GAP)
end if
message_queue = append(message_queue, {text})
end procedure
global procedure fmsg(sequence format, object values)
-- print a formatted message on the message line
if length(message_queue) = 0 then
-- print it right away
set_msg()
printf(CRT, format, values)
sched(TASK_MESSAGE, MESSAGE_GAP)
end if
message_queue = append(message_queue, {format, values})
end procedure
global procedure task_message()
-- display next message in message queue
sequence message
-- first message is already on the screen - delete it
message_queue = message_queue[2..length(message_queue)]
if length(message_queue) = 0 then
wait[TASK_MESSAGE] = INACTIVE -- deactivate this task
else
message = message_queue[1]
set_msg()
if length(message) = 1 then
puts(CRT, message[1])
else
printf(CRT, message[1], message[2])
end if
wait[TASK_MESSAGE] = MESSAGE_GAP
end if
end procedure
----------------------------------------------------------------------------
global procedure show_warp()
-- show current speed (with warning)
set_bk_color(WHITE)
set_color(BLACK)
position(WARP_LINE, WARP_POS)
puts(CRT, "WARP:")
if curwarp > wlimit then
set_color(RED+BLINKING)
end if
printf(CRT, "%d", curwarp)
end procedure
-- how long it takes Euphoria to move at warp 0 thru 5:
constant warp_time = {0, 20, 4.5, 1.5, .67, .25}
global procedure setwarp(warp new)
-- establish a new warp speed for the Euphoria
if new != curwarp then
wait[TASK_EMOVE] = warp_time[new+1]
eat[TASK_EMOVE] = (5-new)/20 + 0.05
sched(TASK_EMOVE, wait[TASK_EMOVE])
curwarp = new
show_warp()
end if
end procedure
global procedure gtext()
-- print text portion of galaxy scan
set_bk_color(BLUE)
position(2, 37)
set_color(LIGHT_RED)
puts(CRT, "C ")
set_color(BROWN)
puts(CRT, "P ")
set_color(YELLOW)
puts(CRT, "B")
set_color(WHITE)
position(3, 15)
puts(CRT, "1 2 3 4 5 6 7")
for i = 1 to 7 do
position(2*i + 2, 10)
printf(CRT, "%d.", i)
end for
position(18, 37)
set_color(BRIGHT_WHITE)
printf(CRT, "C: %d ", c_remaining())
position(19, 24)
set_color(WHITE)
printf(CRT, "Planets: %d BASIC: %d", {nobj[G_PL], nobj[G_BAS]})
if bstat = TRUCE then
puts(CRT, " TRUCE ")
elsif bstat = HOSTILE then
puts(CRT, " HOSTILE ")
else
set_color(WHITE+BLINKING)
puts(CRT, " CLOAKING")
set_color(WHITE)
end if
position(20, 24)
printf(CRT, "Bases: %d Fortran: %d ", {nobj[G_BS], nobj[G_FOR]})
position(20, 67)
set_color(BLUE)
set_bk_color(WHITE)
if level = 'n' then
puts(CRT, "NOVICE LEVEL")
else
puts(CRT, "EXPERT LEVEL")
end if
end procedure
function source_of_energy(g_index qrow, g_index qcol, object_type t)
-- see if there is any energy left from planets / bases in this quadrant
pb_row start, stop
if t = G_BS then
start = 1
stop = NBASES
else
start = NBASES + 1
stop = length(pb)
end if
for pbi = start to stop do
if pb[pbi][P_TYPE] != DEAD then
if pb[pbi][P_QR] = qrow then
if pb[pbi][P_QC] = qcol then
if pb[pbi][P_EN] > 0 then
return TRUE
end if
end if
end if
end if
end for
return FALSE
end function
function g_screen_pos(g_index qrow, g_index qcol)
-- compute position on screen to display a galaxy scan quadrant
return {5 + qcol * 8, qrow * 2 + 2}
end function
global procedure gquad(g_index qrow, g_index qcol)
-- print one galaxy scan quadrant
natural nk, np, nb
sequence quad_info
screen_pos gpos
gpos = g_screen_pos(qrow, qcol)
position(gpos[2], gpos[1])
quad_info = galaxy[qrow][qcol]
if quad_info[1] then
nk = quad_info[G_KRC] + quad_info[G_ANC] + quad_info[G_CPP]
set_color(LIGHT_RED)
printf(CRT, "%d ", nk)
np = quad_info[G_PL]
if np = 0 then
set_color(BROWN)
elsif source_of_energy(qrow, qcol, G_PL) then
set_color(BROWN)
else
set_color(GRAY)
end if
printf(CRT, "%d ", np)
nb = quad_info[G_BS]
if nb = 0 then
set_color(YELLOW)
elsif source_of_energy(qrow, qcol, G_BS) then
set_color(YELLOW)
else
set_color(GRAY)
end if
printf(CRT, "%d", nb)
set_color(WHITE)
else
puts(CRT, "*****")
end if
end procedure
global procedure upg(g_index qrow, g_index qcol)
-- update galaxy scan quadrant
if scanon then
set_bk_color(BLUE)
set_color(WHITE)
gquad(qrow, qcol)
end if
end procedure
sequence prev_box
prev_box = {}
global procedure gsbox(g_index qrow, g_index qcol)
-- indicate current quadrant on galaxy scan
screen_pos gpos
if scanon then
set_bk_color(BLUE)
if length(prev_box) = 2 then
-- clear the previous "box" (could be gone already)
position(prev_box[2], prev_box[1]-1)
puts(CRT, ' ')
position(prev_box[2], prev_box[1]+5)
puts(CRT, ' ')
end if
set_color(WHITE)
gquad(qrow, qcol)
gpos = g_screen_pos(qrow, qcol)
position(gpos[2], gpos[1]-1)
set_color(BRIGHT_WHITE)
puts(CRT, '[')
position(gpos[2], gpos[1]+5)
puts(CRT, ']')
prev_box = gpos
end if
end procedure
constant dir_places = {{1, 6},{0, 6},{0, 3},{0, 0},{1, 0},{2, 0},{2, 3},{2, 6}}
global procedure dir_box()
-- direction box
sequence place
set_bk_color(RED)
set_color(BLACK)
position(WARP_LINE, DIRECTIONS_POS)
puts(CRT, "4 3 2")
position(CMD_LINE, DIRECTIONS_POS)
puts(CRT, "5 + 1")
position(MSG_LINE, DIRECTIONS_POS)
puts(CRT, "6 7 8")
place = dir_places[curdir]
position(place[1]+WARP_LINE,place[2]+DIRECTIONS_POS)
set_bk_color(GREEN)
printf(CRT, "%d", curdir)
set_bk_color(WHITE)
end procedure
global procedure wtext()
-- print torpedos, pods, deflectors in text window
set_bk_color(WHITE)
set_color(BLACK)
position(WARP_LINE, WEAPONS_POS)
printf(CRT, "%s %s %s ", {ts, ds, ps})
end procedure
global procedure stext()
-- print text window info
position(QUAD_LINE, 1)
set_bk_color(CYAN)
set_color(MAGENTA)
printf(CRT,
"--------------------------------- QUADRANT %d.%d ---------------------------------"
,{qrow, qcol})
set_bk_color(WHITE)
set_color(BLACK)
show_warp()
wtext()
position(WARP_LINE, ENERGY_POS)
printf(CRT, "ENERGY:%d ", floor(quadrant[EUPHORIA][Q_EN]))
position(CMD_LINE, CMD_POS-30)
puts(CRT, "COMMAND(1-8 w p t a g $ ! x): ")
dir_box()
end procedure
procedure p_source(valid_quadrant_row row)
-- print a base or planet
h_coord x
v_coord y
x = quadrant[row][Q_X]
y = quadrant[row][Q_Y]
if quadrant[row][Q_TYPE] = G_PL then
write_screen(x, y, PLANET_TOP)
write_screen(x, y+1, PLANET_MIDDLE)
write_screen(x, y+2, PLANET_BOTTOM)
else
write_screen(x, y, BASE)
write_screen(x, y+1, BASE)
end if
end procedure
procedure p_ship(valid_quadrant_row row)
-- reprint a ship to get color
h_coord x
v_coord y
object_type t
sequence shape
x = quadrant[row][Q_X]
y = quadrant[row][Q_Y]
t = quadrant[row][Q_TYPE]
shape = read_screen({x, length(ship[t][1])}, y)
write_screen(x, y, shape)
end procedure
procedure refresh_obj()
-- reprint objects after a galaxy scan
for i = 1 to length(quadrant) do
if quadrant[i][Q_TYPE] = G_BS or quadrant[i][Q_TYPE] = G_PL then
p_source(i)
elsif quadrant[i][Q_TYPE] != DEAD then
p_ship(i)
end if
end for
end procedure
global procedure setg1()
-- end display of galaxy scan
if scanon then
scanon = FALSE
ShowScreen()
refresh_obj()
end if
end procedure
global procedure pobj()
-- print objects in a new quadrant
h_coord x
v_coord y
sequence c
natural len
object_type t
sequence taken
set_bk_color(BLACK)
set_color(WHITE)
BlankScreen(TRUE)
-- print stars
for i = 1 to 15 do
write_screen(rand(HSIZE), rand(VSIZE), STAR)
end for
-- print planets and bases
taken = {}
for row = 2 to length(quadrant) do
if find(quadrant[row][Q_TYPE], {G_PL, G_BS}) then
-- look it up in pb sequence
for pbi = 1 to length(pb) do
if pb[pbi][P_TYPE] = quadrant[row][Q_TYPE] then
if pb[pbi][P_QR] = qrow and pb[pbi][P_QC] = qcol then
if not find(pbi, taken) then
quadrant[row][Q_X] = pb[pbi][P_X]
quadrant[row][Q_Y] = pb[pbi][P_Y]
quadrant[row][Q_PBX] = pbi
taken = taken & pbi
exit
end if
end if
end if
end for
p_source(row)
end if
end for
-- print ships
for row = 2 to length(quadrant) do
if not find(quadrant[row][Q_TYPE], {G_PL, G_BS}) then
len = length(ship[quadrant[row][Q_TYPE]][1])
while TRUE do
-- look for an empty place to put the ship
x = rand(HSIZE - len - 5) + 3 -- allow space for Euphoria to enter
y = rand(VSIZE - 2) + 1
c = read_screen({x, len}, y)
if not find(FALSE, c = ' ' or c = STAR) then
exit
end if
end while
quadrant[row][Q_UNDER] = c
quadrant[row][Q_X] = x
quadrant[row][Q_Y] = y
t = quadrant[row][Q_TYPE]
if x < quadrant[EUPHORIA][Q_X] then
c = ship[t][2]
else
c = ship[t][1]
end if
write_screen(x, y, c)
end if
end for
end procedure